Consider the following data:

length(x)
[1] 15

Given this data, we have the following assumptions:

In this case, our known population standard deviation is 1.

rr sigma <- 1

We want to conduct the following hypothesis test:

\[ H_0: \mu = 0 \]

\[ H_a: \mu > 0 \]

\[ \alpha = 0.05 \]

First, we’ll create a function using the following formula to give us our z test statistic.

\[ z = \frac{\bar{x} - \mu}{\sigma / \sqrt{n}} \]

rr alpha <- 0.05 z_test_stat <- function(x, mu, sigma) { x_bar <- mean(x) n <- length(x) (x_bar - mu) / (sigma / sqrt(n)) }

Now we’ll conduct the hypothesis test.

(z <- z_test_stat(x, 0, 1))
[1] 1.528537
(p_val <- pnorm(z, mean = 0, sd = 1, lower.tail = FALSE))
[1] 0.06318958

What is the critical value (how big does z need to be)?

critical_val <- qnorm(alpha, mean = 0, sd = 1, lower.tail = FALSE)
critical_val
[1] 1.644854

Conclusion: Fail to reject \(H_0\) since p-value is greater than \(\alpha = 0.05\).

This approach requires theory to know that the sampling distribution of the Z statistic has a standard normal distribution.

We could instead use a simulation study to find the sampling distribution of Z and compute p-values, power, etc.

rr simulate <- function(n, mu, sd, n_reps = 1000) { replicate(n_reps, z_test_stat(rnorm(n, mu, sd), mu, sd)) }

rr test_stat_under_h0 <- simulate(length(x), 0, 1)

hist(test_stat_under_h0)
abline(v = z, col = "red", lwd = 2)

Now that we have a distribution of test statistics, we can once again perform our hypothesis test, this time leaning on our simulation instead of leaning on theory.

p_val <- mean(test_stat_under_h0 >= z)
p_val
[1] 0.058
ci <- function(x) {
  p <- mean(x)
  ci <- qnorm(0.975) * sqrt(p * (1 - p) / length(x))
  c(lower = p - ci,
    p_value = p,
    upper = p + ci)
}
ci(test_stat_under_h0 >= z)
    lower   p_value     upper 
0.0435127 0.0580000 0.0724873 
LS0tCnRpdGxlOiAiTWVhbiIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKYGBge3Igc2V0dXAsIGluY2x1ZGUgPSBGQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGNhY2hlID0gVFJVRSkKYGBgCgpDb25zaWRlciB0aGUgZm9sbG93aW5nIGRhdGE6CgpgYGB7cn0KeCA8LSBjKDIuMTEsCiAgICAgICAwLjg3LAogICAgICAgMC45NSwKICAgICAgIDEuNTEsCiAgICAgICAwLjI4LAogICAgICAgMS40NSwKICAgICAgIDAuMTgsCiAgICAgICAwLjUyLAogICAgICAgLTEuMTYsCiAgICAgICAtMC41NiwKICAgICAgIDAuMTMsCiAgICAgICAwLjY1LAogICAgICAgLTAuMDEsCiAgICAgICAwLjk1LAogICAgICAgLTEuOTUpCgpsZW5ndGgoeCkKYGBgCgpHaXZlbiB0aGlzIGRhdGEsIHdlIGhhdmUgdGhlIGZvbGxvd2luZyBhc3N1bXB0aW9uczoKCiogSW5kZXBlbmRlbmNlCiogS25vd24gc3RhbmRhcmQgZGV2aWF0aW9uCiogTm9ybWFsbHkgZGlzdHJpYnV0ZWQgcG9wdWxhdGlvbgoKSW4gdGhpcyBjYXNlLCBvdXIga25vd24gcG9wdWxhdGlvbiBzdGFuZGFyZCBkZXZpYXRpb24gaXMgMS4KCmBgYHtyfQpzaWdtYSA8LSAxCmBgYAoKV2Ugd2FudCB0byBjb25kdWN0IHRoZSBmb2xsb3dpbmcgaHlwb3RoZXNpcyB0ZXN0OgoKJCQKSF8wOiBcbXUgPSAwCiQkCgokJApIX2E6IFxtdSA+IDAKJCQKCiQkClxhbHBoYSA9IDAuMDUKJCQKCkZpcnN0LCB3ZSdsbCBjcmVhdGUgYSBmdW5jdGlvbiB1c2luZyB0aGUgZm9sbG93aW5nIGZvcm11bGEgdG8gZ2l2ZSB1cyBvdXIgeiB0ZXN0CnN0YXRpc3RpYy4KCiQkCnogPSBcZnJhY3tcYmFye3h9IC0gXG11fXtcc2lnbWEgLyBcc3FydHtufX0KJCQKCmBgYHtyfQphbHBoYSA8LSAwLjA1CnpfdGVzdF9zdGF0IDwtIGZ1bmN0aW9uKHgsIG11LCBzaWdtYSkgewogIHhfYmFyIDwtIG1lYW4oeCkKICBuIDwtIGxlbmd0aCh4KQogICh4X2JhciAtIG11KSAvIChzaWdtYSAvIHNxcnQobikpCn0KYGBgCgpOb3cgd2UnbGwgY29uZHVjdCB0aGUgaHlwb3RoZXNpcyB0ZXN0LgoKYGBge3J9Cih6IDwtIHpfdGVzdF9zdGF0KHgsIDAsIDEpKQpgYGAKCmBgYHtyfQoocF92YWwgPC0gcG5vcm0oeiwgbWVhbiA9IDAsIHNkID0gMSwgbG93ZXIudGFpbCA9IEZBTFNFKSkKYGBgCgpXaGF0IGlzIHRoZSBjcml0aWNhbCB2YWx1ZSAoaG93IGJpZyBkb2VzIGB6YCBuZWVkIHRvIGJlKT8KYGBge3J9Cihjcml0aWNhbF92YWwgPC0gcW5vcm0oYWxwaGEsIG1lYW4gPSAwLCBzZCA9IDEsIGxvd2VyLnRhaWwgPSBGQUxTRSkpCmBgYAoKQ29uY2x1c2lvbjogRmFpbCB0byByZWplY3QgJEhfMCQgc2luY2UgcC12YWx1ZSBpcyBncmVhdGVyIHRoYW4gJFxhbHBoYSA9IDAuMDUkLgoKVGhpcyBhcHByb2FjaCByZXF1aXJlcyB0aGVvcnkgdG8ga25vdyB0aGF0IHRoZSBzYW1wbGluZyBkaXN0cmlidXRpb24gb2YgdGhlIFoKc3RhdGlzdGljIGhhcyBhIHN0YW5kYXJkIG5vcm1hbCBkaXN0cmlidXRpb24uCgpXZSBjb3VsZCBpbnN0ZWFkIHVzZSBhIHNpbXVsYXRpb24gc3R1ZHkgdG8gZmluZCB0aGUgc2FtcGxpbmcgZGlzdHJpYnV0aW9uIG9mIFoKYW5kIGNvbXB1dGUgcC12YWx1ZXMsIHBvd2VyLCBldGMuCgpgYGB7cn0Kc2ltdWxhdGUgPC0gZnVuY3Rpb24obiwgbXUsIHNkLCBuX3JlcHMgPSAxMDAwKSB7CiAgcmVwbGljYXRlKG5fcmVwcywgel90ZXN0X3N0YXQocm5vcm0obiwgbXUsIHNkKSwgbXUsIHNkKSkKfQpgYGAKCmBgYHtyfQp0ZXN0X3N0YXRfdW5kZXJfaDAgPC0gc2ltdWxhdGUobGVuZ3RoKHgpLCAwLCAxKQpgYGAKCmBgYHtyfQpoaXN0KHRlc3Rfc3RhdF91bmRlcl9oMCkKYWJsaW5lKHYgPSB6LCBjb2wgPSAicmVkIiwgbHdkID0gMikKYGBgCgpOb3cgdGhhdCB3ZSBoYXZlIGEgZGlzdHJpYnV0aW9uIG9mIHRlc3Qgc3RhdGlzdGljcywgd2UgY2FuIG9uY2UgYWdhaW4gcGVyZm9ybQpvdXIgaHlwb3RoZXNpcyB0ZXN0LCB0aGlzIHRpbWUgbGVhbmluZyBvbiBvdXIgc2ltdWxhdGlvbiBpbnN0ZWFkIG9mIGxlYW5pbmcgb24gCnRoZW9yeS4KCmBgYHtyfQpwX3ZhbCA8LSBtZWFuKHRlc3Rfc3RhdF91bmRlcl9oMCA+PSB6KQpwX3ZhbApgYGAKCmBgYHtyfQpjaSA8LSBmdW5jdGlvbih4KSB7CiAgcCA8LSBtZWFuKHgpCiAgY2kgPC0gcW5vcm0oMC45NzUpICogc3FydChwICogKDEgLSBwKSAvIGxlbmd0aCh4KSkKICBjKGxvd2VyID0gcCAtIGNpLAogICAgcF92YWx1ZSA9IHAsCiAgICB1cHBlciA9IHAgKyBjaSkKfQpgYGAKCmBgYHtyfQpjaSh0ZXN0X3N0YXRfdW5kZXJfaDAgPj0geikKYGBgCgoKCgoK